perm filename SUB[E,ALS] blob
sn#257785 filedate 1977-01-12 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
C00009 ENDMK
Cā;
;SUBSTR SUBST1 SUBOVE SUBST5 QFAST1 QFAST5 SUBSAY QFAST6 QFAST9
SUBSTR: PUSHJ P,ENDSET
TLO F,NOCHK
HRRZ H,FSEND
ADDI H,1
MOVE I,ARRLIN ;Set by SETARR to line for action
MOVE E,SAVEE ;This may have been changed
SETZB B,G
HLLZ Q,TXTFLG(I)
LEG HLLZM Q,TXTFLG(H)
MOVEM H,ARRLIN
TLNE Q,WINBIT
MOVEM H,WINLIN
MOVE A,I
MOVE TT,(A)
LEG MOVEM TT,(H)
HLRZ T,TT
HRRM H,(T)
CAIN T,PAGE
TRO F,UPDTXT
HRLM H,(TT)
AOS TT,TXTNUM
LEG HRRM TT,TXTSER(H)
MOVEM TT,SRCNUM ;This will have been changed
ADD A,[440700,,LLDESC] ;Location where text starts
MOVE D,H
ADD D,[440700,,LLDESC]
MOVEI Q,SUBBUF(E) ;Substitution text location
ADD Q,[440700,,0]
HRRE T,SRCOFF ;Character position to start deletion
JUMPLE T,SUBST1 ;Substitution starts with the first character
ILDB C,A
LEG IDPB C,D ;Copy text to deletion point
CAIN C,11
PUSHJ P,SUBTAB ;We must do this to get G and B set right
AOS B
SOJG T,.-5
SUBST1: HLRZ T,SUBSIZ(E) ;Get count of text to delete
MOVEM A,ASAVE
SUBST0: ILDB C,A ;Index over replaced text
CAIN C,15
JRST SUBOVE ;Not allowed at present
CAIN C,11 ;TABs require special treatment
PUSHJ P,EATTAB
SOJG T,SUBST0 ;Count deletions
HRRZ T,SUBSIZ(E) ;Length of substitution string is here
JUMPE T,SUBST3 ;The null substitution case
SUBST2: ILDB C,Q
LEG IDPB C,D
CAIN C,11
PUSHJ P,FIXTAB ;Must fix TAB representation (note skip return)
AOS B
SOJG T,SUBST2 ;Count insertions
SUBST3: ILDB C,A ;Get rest of original text
CAIN C,15 ;Watch for the CR
JRST SUBST4
LEG IDPB C,D
CAIN C,11
PUSHJ P,SUBTAB ;Do proper thing for TABs (note skip return)
AOS B
JRST SUBST3 ;Go on anyway, test comes later
EATTAB: ILDB C,A ;Eat all blanks to the next TAB
CAIE C,11
JRST .-2
POPJ P,
;This routine eats old spaces associated with tabs and puts in the correct number.
;It also keeps the correct records in G and B.
SUBTAB: ILDB C,A
CAIE C,11 ;First eat all old spaces
JRST .-2
FIXTAB: ADDI G,(B)
HRLI B,(B)
TLO B,-10
MOVEI TT,40
LEG IDPB TT,D ;Insert correct number of spaces
AOBJN B,.-1
SUBI G,-1(B)
LEG IDPB C,D ;Deposit terminating TAB
AOS (P) ;Skip return as we have already updated B enough
POPJ P,
;Substitution for CR not allowed
SUBOVE: MOVE A,ASAVE ;Back up to start of deletion
SOS QCHR ;So count will be correct
SOS SUBFLG(E)
OUTSTR [ASCIZ/
Replacing a CR (line /]
SETZM TYOPNT
TYPDEC ARRL
OUTSTR [ASCIZ/, page /]
TYPDEC CURPAG
OUTSTR [ASCIZ/) is not allowed. Do you want to stop? /]
PUSHJ P, YESCHK
HRRZS QCHR
JRST SUBST3
;We have come to the end of the line
SUBST4: HRRZ T,B ;Are there be any chars left?
JUMPN T,SUBST5 ;Yes
MOVEI T,40 ;Need at least 1 char
LEG IDPB T,D
TLO F,NULLIN ;No text in this line
SUBST5:
LEG IDPB C,D ;Now the CR
MOVEI C,12
LEG IDPB C,D
TDZA C,C ;Set C to zero and skip
LEG IDPB C,D
TLNE D,760000
JRST .-2 ;Pad out with nulls
;Text must be in ASCID
MOVEI T,LLDESC(H)
MOVEI TT,1
IORM TT,(T)
CAIGE T,(D)
AOJA T,.-2
;Now we must give up the space originally used by the line
QFAST1: HLRZ T,TXTCNT(I)
MOVNI T,(T) ;and do 1's complement of T
ADDM T,CHARS
;Add to CHARS, fix TXTCNT
ADDI G,2(B) ;Allow for CR and LF in G count
ADDM G,CHARS ;Previously debited by the number in original line
HRLZS G
IORI G,(B)
LEG MOVEM G,TXTCNT(H)
MOVEI TT,2(D)
MOVSI T,TXTCOD ;A fancy way to store 2 in left half!
FSFIX TT,T
PUSHJ P,ENDFIX
MOVE A,I
PUSHJ P,FSGIVE ;Give up storage space.
TLZ F,NOCHK
QFAST6: PUSHJ P,SETWRT ;May need attention
HRRZ TT,SUBSIZ(E)
ADD TT,SRCOFF
SUBI TT,1
HRRZM TT,SRCOFF ;Move to last character of substitution
;Update count and test for continuance
MOVE TT,QCHR
AOBJP TT,QFAST4
MOVEM TT,QCHR
MOVEM TT,SUBFLG(E)
QFAST7: TRZ F,ARG!REL
TLZ F,OKF
CAIN E,FNDBUF
JRST FINBSL ;Go to the X routine
JRST FNDBSL ;Go to the page-only routine
QFAST4: JUMPE TT,QFAST5
QFAST9: PUSHJ P,ABCRL0 ;Type CRLF, preserving ACs
OUTSTR [ASCIZ /As requested, /]
AOS SUBFLG(E)
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSTP ;To report on actual number replaced
QFAST5: SETZM QCHR ;Have done 1 substitution
SUBSAY: PUSHJ P,ABCRL0 ;Type CRLF preserving ACs.
OUTSTR [ASCIZ /You have replaced \/]
MOVE B,SDATA
ADDI B,SRCBUF
JRST SUBSP3